home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / languages / obrn-a_1.5_lib.lha / oberon-a / source2.lha / Source / Kernel / Mark.asm < prev    next >
Encoding:
Assembly Source File  |  1995-01-26  |  6.8 KB  |  179 lines
  1. **********************************************************************
  2. *
  3. *    $RCSfile: Mark.asm $
  4. * Description: Runtime support for the Oberon-A compiler
  5. *
  6. *  Created by: fjc (Frank Copeland)
  7. *   $Revision: 1.2 $
  8. *     $Author: fjc $
  9. *       $Date: 1995/01/26 00:37:31 $
  10. *
  11. * Copyright © 1994, Frank Copeland.
  12. * This file is part of the Oberon-A Library.
  13. * See Oberon-A.doc for conditions of use and distribution.
  14. *
  15. * Log entries are at the end of the file.
  16. *
  17. **********************************************************************
  18.  
  19. ;---------------------------------------------------------------------
  20. ;    Program unit hunk name
  21. ;    !! DO NOT CHANGE UNLESS YOU KNOW WHAT YOU ARE DOING !!
  22.  
  23.     TTL Kernel
  24.  
  25. ;---------------------------------------------------------------------
  26. ;    Defines
  27.  
  28. SysBit          EQU 0
  29. ArrayBit        EQU 1
  30. MarkBitB        EQU 7
  31. MarkBitL        EQU 31
  32. tag             EQU -4
  33. size            EQU -12
  34. elemSize        EQU -16
  35. arrpos          EQU -20
  36. PtrTabOffset    EQU 36
  37.  
  38.  
  39. ;---------------------------------------------------------------------
  40. ;
  41. ; PROCEDURE Kernel_Mark (q {A0} : Pointer)
  42. ;
  43. ; Kernel_Mark is a direct implementation of the algorithm described in
  44. ; the Oberon Technical Notes, part 5 (see TechNotes.doc).  It forms
  45. ; the inner loop of the mark phase and assumes that the root pointer
  46. ; variable passed in A0 has already been marked.  The algorithm has
  47. ; been modified slightly to reflect the different tag encodings and
  48. ; memory block formats used by Oberon-A.
  49. ;
  50. ; Address registers A1-A3 and all the data registers are free on
  51. ; entry.
  52. ;
  53. ; VAR
  54. ;   n {A1}, t {A2}, tos {A3} : Pointer;
  55. ;   offset {D0}, tag {A4,D3} : LONGINT;
  56. ;   qmask {D1}, ntag {D2} : SET;
  57. ;
  58. ;---------------------------------------------------------------------
  59.  
  60.     SECTION OberonSys,CODE
  61.  
  62.     XDEF    Kernel_Mark
  63.  
  64. Kernel_Mark:
  65.  
  66.     MOVE.L  A4,-(A7)                ; (* Create an extra free register *)
  67.     BTST.B  #ArrayBit,tag+3(A0)     ; IF 1 IN q.tag THEN
  68.     BEQ.S   M1
  69.     CLR.L   arrpos(A0)              ;   q.arrpos := 0;
  70.     MOVE.L  #$80000002,D1           ;   qmask := {1, 31}
  71.     BRA.S   M2
  72. M1:                                 ; ELSE
  73.     MOVE.L  #$80000000,D1           ;   qmask := {31}
  74. M2:                                 ; END;
  75.     MOVE.L  A0,A2                   ; t := q;
  76.     MOVE.L  tag(A0),D3              ; tag := q.tag - {1, 31} + PtrTabOffset
  77.     AND.L   #$7FFFFFFD,D3
  78.     ADD.L   #PtrTabOffset,D3
  79.     SUB.L   A3,A3                   ; tos := NIL;
  80. Loop:                               ; LOOP {H}
  81.     MOVE.L  D3,A4                   ;   offset := mem[tag];
  82.     MOVE.L  (A4),D0
  83.     BPL.S   L3                      ;   IF offset < 0 THEN
  84.     MOVE.L  D3,D4                   ;     q.tag := tag + offset + qmask;
  85.     ADD.L   D0,D4
  86.     OR.L    D1,D4
  87.     MOVE.L  D4,tag(A0)
  88.     BTST.B  #ArrayBit,D1            ;     IF 1 IN qmask
  89.     BEQ.S   L1
  90.     MOVE.L  elemSize(A0),D4
  91.     ADD.L   arrpos(A0),D4
  92.     CMP.L   size(A0),D4             ;     & (q.arrpos + q.elemSize # q.size) THEN
  93.     BEQ.S   L1
  94.     MOVE.L  elemSize(A0),D4         ;       INC(q.arrpos,q.elemSize);
  95.     ADD.L   D4,arrpos(A0)
  96.     ADD.L   D0,D3                   ;       INC(tag, offset + PtrTabOffset - 4);
  97.     ADD.L   #PtrTabOffset-4,D3
  98.     ADD.L   elemSize(A0),A2         ;       INC(t, q.elemSize)
  99.     BRA     L5
  100. L1:
  101.     MOVE.L  A3,D4                   ;     ELSIF tos = NIL THEN
  102.     BEQ     Exit                    ;       EXIT
  103.                                     ;     ELSE
  104.     MOVE.L  tag(A3),D1              ;       qmask := tos.tag;
  105.     MOVE.L  D1,D3                   ;       tag := qmask - {1, 31};
  106.     AND.L   #$7FFFFFFD,D3
  107.     AND.L   #$80000002,D1           ;       qmask := qmask * {1, 31};
  108.     MOVE.L  A3,A2                   ;       t := tos;
  109.     BTST.B  #ArrayBit,D1            ;       IF 1 IN qmask THEN
  110.     BEQ.S   L2
  111.     ADD.L   arrpos(A3),A2           ;         INC (t, tos.arrpos)
  112. L2:                                 ;       END;
  113.     MOVE.L  D3,A4                   ;       offset := mem[tag];
  114.     MOVE.L  (A4),D0
  115.     MOVE.L  0(A2,D0.L),A1           ;       n := mem[t + offset];
  116.     MOVE.L  A0,0(A2,D0.L)           ;       mem[t + offset] := q;
  117.     MOVE.L  A3,A0                   ;       q := tos;
  118.     MOVE.L  A1,A3                   ;       tos := n
  119.     BRA.S   L5                      ;     END
  120. L3:                                 ;   ELSE
  121.     MOVE.L  0(A2,D0.L),D4           ;     n := mem[t + offset];
  122.     BEQ.S   L5                      ;     IF (n # NIL) THEN
  123.     MOVE.L  D4,A1
  124.     MOVE.L  tag(A1),D2              ;       ntag := n.tag;
  125.     BTST.L  #MarkBitL,D2            ;       IF ~(31 IN ntag) [Unmarked]
  126.     BNE.S   L5
  127. ;    MOVE.L  D2,D4                  ;         n.tag := ntag + {31};
  128. ;    BSET.L  #MarkBitL,D4
  129. ;    MOVE.L  D4,tag(A1)
  130.     BSET.B  #MarkBitB,tag(A1)       ;         n.tag := n.tag + {31};
  131.     BTST.L  #SysBit,D2              ;         IF ~(0 IN ntag) THEN [~SysBlk]
  132.     BNE.S   L5
  133.     MOVE.L  D3,tag(A0)              ;           q.tag := tag + qmask;
  134.     OR.L    D1,tag(A0)
  135.     BTST.B  #ArrayBit,D2            ;           IF ~(1 IN ntag) THEN
  136.     BNE.S   L4
  137.     MOVE.L  A3,0(A2,D0.L)           ;             mem[t + offset] := tos;
  138.     MOVE.L  A0,A3                   ;             tos := q;
  139.     MOVE.L  A1,A0                   ;             q := n;
  140.     MOVE.L  A0,A2                   ;             t := q;
  141.     MOVE.L  D2,D3                   ;             tag := ntag + PtrTabOffset - 4;
  142.     ADD.L   #PtrTabOffset-4,D3
  143.     MOVE.L  #$80000000,D1           ;             qmask := {31}
  144.     BRA.S   L5
  145. L4:
  146.     BTST.B  #SysBit,D2              ;           ELSIF ~(0 IN ntag) THEN
  147.     BNE.S   L5
  148.     MOVE.L  A3,0(A2,D0.L)           ;             mem[t + offset] := tos;
  149.     MOVE.L  A0,A3                   ;             tos := q;
  150.     MOVE.L  A1,A0                   ;             q := n;
  151.     CLR.L   arrpos(A0)              ;             q.arrpos := 0;
  152.     MOVE.L  A0,A2                   ;             t := q;
  153.     MOVE.L  D2,D3                   ;             tag := ntag - {1} + PtrTabOffset - 4;
  154.     BCLR.B  #ArrayBit,D3
  155.     ADD.L   #PtrTabOffset-4,D3
  156.     MOVE.L  #$80000002,D1           ;             qmask := {1, 31}
  157.                                     ;           END (* ELSIF *)
  158.                                     ;         END
  159.                                     ;       END (* IF *)
  160.                                     ;     END (* IF *)
  161. L5:                                 ;   END; (* ELSE *)
  162.     ADDQ.L  #4,D3                   ;   INC(tag, 4)
  163.     BRA     Loop                    ; END (* LOOP *)
  164. Exit:
  165.     MOVE.L (A7)+,A4                 ; (* restore A4 *)
  166.     RTS
  167.  
  168. ;---------------------------------------------------------------------
  169.  
  170.     END  ; Kernel
  171.  
  172. **********************************************************************
  173. *
  174. * $Log: Mark.asm $
  175. ;; Revision 1.2  1995/01/26  00:37:31  fjc
  176. ;; - Release 1.5
  177. ;;
  178. **********************************************************************
  179.